home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
MYMUD21.ZIP
/
MMUD21.ZIP
/
SOURCE
/
SOURCE.ZIP
/
BIN_DB.PAS
next >
Wrap
Pascal/Delphi Source File
|
1995-01-21
|
16KB
|
535 lines
{$I COPYRGHT.INC}
(*----------------------------------------------------------------------------*
Binary database routines. Implements a binary database for MyMUD. The
database itself is modelled after the tinymud database.
*---------------------------------------------------------------------------*)
Unit BIN_DB;
interface
Uses Dos,Header,MyIO,Out_Proc;
Type Database = Object
ObjRec : ObjRecord; { Hold the current objectrecord }
TxtRec : TextRecord; { Hold the current text }
ObjFile : File of ObjRecord;
TxtFile : File;
DBName : ComStr; { The name of the current database }
CObjNr : Integer; { The last read objectrecord }
{ The player functions. Search and modify the .PLY file }
Function FindPlayer(UserName : NameString):Integer;
Procedure AddPlayer(ObjNr : Integer);
{ The Database functions. Search and modify the .IDX file }
Procedure Init;
Procedure ReadObj(Nr : Integer);
Function ExistObj(Nr : Integer):Boolean;
Procedure UpdateObj(Nr : Integer);
Function AddObj:integer;
Procedure WriteRecord;
Procedure Final;
Procedure ResetAll;
{ The description file functions. Search and modify the.TXT }
{ file }
Procedure Describe(Msg : String);
Procedure Finger(Msg : String);
Function Macro:String;
Procedure OFail(Msg : String);
Procedure OSuccess(Msg : String);
Procedure Fail(Msg : String);
Procedure Success(Msg : String);
Function Name:String;
{ the flag functions. }
Function IsRoom:Boolean;
Function IsThing:Boolean;
Function IsExit:Boolean;
Function IsPlayer:Boolean;
Function IsDrone:Boolean;
Function LevelOk(Level : Byte):Boolean;
Function IsTemple:Boolean;
Function IsHaven:Boolean;
Function IsShop:Boolean;
Function IsLoud:Boolean;
Function CanTeleport:Boolean;
Function IsLinkOk:Boolean;
Function IsSticky:Boolean;
Function IsInvisible:Boolean;
Function IsForSale:Boolean;
Function IsChownOK:Boolean;
Function IsOwnedBy(Player : Integer):Boolean;
Function IsOwner(ObjNr : Integer):Boolean;
Function WhichGender:GenderType;
End;
Type ContextType = Record
Player : Integer;
Room : Integer;
PlayerName : String[40];
Level : Byte;
Gender : GenderType;
Note : String[50];
DB : Database;
End;
Function MaxLen(Len : Word):Word;
Implementation
Uses Misc;
Function MaxLen(Len : Word):Word;
Begin
If Len>Header.DescMax
Then MaxLen:=Header.DescMax
Else MaxLen:=Len;
End;
(*---------------------------------------------------------------------------*
Converts a string to all uppercase
*---------------------------------------------------------------------------*)
Function UpStr(S : String):String;
Var C : Byte;
Begin
For C:=1 To Length(S) Do
S[C]:=Upcase(S[C]);
UpStr:=S;
End;
(*---------------------------------------------------------------------------*
Find a player in the database
*---------------------------------------------------------------------------*)
Function Database.FindPlayer(UserName : NameString):Integer;
Var Ply : File of Integer;
Rec : Integer;
Begin
ResetAll;
FileMode:=ReadWrite+ShareDenyNone;
Assign(PLY,DBName+'.PLY');
Reset(PLY);
While (Not Eof(Ply)) and (UpStr(Name)<>UpStr(UserName)) Do
Begin
Read(Ply,Rec);
ReadObj(Rec);
End;
Close(Ply);
If UpStr(Name)<>UpStr(UserName)
Then FindPlayer:=NOTHING
Else FindPlayer:=Rec;
End;
(*---------------------------------------------------------------------------*
Add a new user to the .PLY file.
*---------------------------------------------------------------------------*)
Procedure Database.AddPlayer(ObjNr : Integer);
Var Ply : File of Integer;
Begin
FileMode:=ReadWrite+ShareDenyNone;
Assign(PLY,DBName+'.PLY');
Reset(PLY);
Seek(PLY,FileSize(PLY));
Write(PLY,ObjNr);
Close(Ply);
If IoResult<>0
Then Halt(1);
End;
(*---------------------------------------------------------------------------*
Initialize the database functions. Always call first!
*---------------------------------------------------------------------------*)
Procedure Database.Init;
Begin
DBName:=ParamStr(1);
If Pos('.',DBName)>0
Then DBName:=Copy(DBName,1,Pos('.',DBName)-1);
FileMode:=ReadWrite+ShareDenyNone;
Assign(OBJFile,DBName+'.IDX');
Reset(OBJFile);
Assign(TXTFile,DBName+'.DAT');
Reset(TXTFile,1);
FillChar(ObjRec,SizeOf(ObjRec),#00);
FillChar(TxtRec,SizeOf(TxtRec),#00);
CObjNr :=NOTHING;
End;
(*---------------------------------------------------------------------------*
Read a record from the file
*---------------------------------------------------------------------------*)
Procedure DataBase.ReadObj(Nr : Integer);
Begin
If (Nr=CObjNr)
Then Exit
Else CObjNr:=Nr;
Seek(ObjFile,Nr);
Read(ObjFile,ObjRec);
If IoResult<>0
Then Halt(2);
End;
Function DataBase.ExistObj(Nr : Integer):Boolean;
Var Old : LongInt;
Tmp : LongInt;
Begin
Old:=FilePos(ObjFile);
Tmp:=FileSize(ObjFile);
ExistObj:=Tmp>=Nr;
Seek(ObjFile,Old);
End;
Procedure Database.UpdateObj(Nr : Integer);
Begin
Seek(ObjFile,Nr);
Write(ObjFile,ObjRec);
If IoResult<>0
Then Begin
My_WriteLn('ObjRec nr. '+Nr2Str(Nr));
RunError(2);
End;
CObjNr:=NOTHING;
End;
(*---------------------------------------------------------------------------*
Reset the database records.
*---------------------------------------------------------------------------*)
Procedure DataBase.ResetAll;
Begin
FillChar(ObjRec,SizeOf(ObjRec),#00);
FillChar(TxtRec,SizeOf(TxtRec),#00);
CObjNr :=NOTHING;
End;
(*---------------------------------------------------------------------------*
Close the databasefiles.
*---------------------------------------------------------------------------*)
Procedure Database.Final;
Begin
Close(TxtFile);
Close(ObjFile);
End;
(*---------------------------------------------------------------------------*
Add an object to the database
*---------------------------------------------------------------------------*)
Function DataBase.AddObj:Integer;
VAR NewNr:Integer;
Begin
NewNr:=FileSize(ObjFile);
Seek(ObjFile, NewNr);
Write(ObjFile,ObjRec);
AddObj:=NewNr;
End;
(*---------------------------------------------------------------------------*
Write the contents of the current record. (Debugging!)
*---------------------------------------------------------------------------*)
Procedure Database.WriteRecord;
Begin
With ObjRec Do
Begin
My_WriteLn('=================[Record]==========================');
My_WriteLn('ObjNr : '+Nr2Str(CObjNr));
My_WriteLn('Name : '+Name);
My_WriteLn('Password : '+Password);
My_WriteLn('Key : '+Key);
My_WriteLn('Location : '+Nr2Str(Location));
My_WriteLn('Contents : '+Nr2Str(Contents));
My_WriteLn('Exits : '+Nr2Str(Exits));
My_WriteLn('Next : '+Nr2Str(Next));
My_WriteLn('Owner : '+Nr2Str(Owner));
My_WriteLn('Pennies : '+Nr2Str(Pennies));
My_WriteLn('Type : '+Nr2Str(ObjType));
My_WriteLn('Level : '+Nr2Str(ObjLevel));
My_WriteLn('Garbage : '+Nr2Str(Garbage));
My_WriteLn('Sex : '+Nr2Str(Sex));
My_WriteLn('GFlags : '+Nr2Str(GenFlags));
My_WriteLn('AFlags : '+Nr2Str(Attr_Flags));
My_WriteLn('RFlags : '+Nr2Str(Room_Flags));
My_WriteLn('');
End;
End;
(*---------------------------------------------------------------------------*
Write the description of the current object
*---------------------------------------------------------------------------*)
Procedure Database.Describe(Msg : String);
Var RR : Word;
Cnt: Word;
Len: Word;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
If ObjRec.Desc.Length<>0
Then Begin
Seek(TxtFile,ObjRec.Desc.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.Desc.Length),RR);
End
Else Move(Msg[1],TxtRec[0],Length(Msg));
If TxtRec[0]=#00
Then My_WriteLn('You don''t see anything special.')
Else WriteText(TxtRec);
End;
(*---------------------------------------------------------------------------*
Write the fingerinfo of the current object
*---------------------------------------------------------------------------*)
Procedure Database.Finger(Msg : String);
Var RR : Word;
Cnt: Word;
Len: Word;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
If ObjRec.Finger.Length<>0
Then Begin
Seek(TxtFile,ObjRec.Finger.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.Finger.Length),RR);
End
Else Move(Msg[1],TxtRec[0],Length(Msg));
If TxtRec[0]=#00
Then My_WriteLn('You don''t see anything special.')
Else WriteText(TxtRec);
End;
(*---------------------------------------------------------------------------*
Return a macro string
*---------------------------------------------------------------------------*)
Function Database.Macro:String;
Var RR : Word;
Cnt: Word;
S : String;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
Seek(TxtFile,ObjRec.Macro.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.Macro.Length),RR);
Cnt:=0;
S:='';
While (Cnt<=RR) and (Length(S)<255) Do
Begin
Case TxtRec[Cnt] of
#00 : ;
#13 : Begin
If TxtRec[Cnt+1]=#10
then Inc(Cnt);
S:=S+'^';
End;
#10 : Begin
If TxtRec[Cnt+1]=#13
then Inc(Cnt);
S:=S+'^';
End;
#9 : S:=S+' ';
#8 : ;
Else S:=S+TxtRec[Cnt];
End;
Inc(Cnt);
End;
Macro:=S;
End;
(*---------------------------------------------------------------------------*
Write the FAIL tekst of the current record
*---------------------------------------------------------------------------*)
Procedure Database.Fail(Msg : String);
Var RR : Word;
Cnt: Word;
Len: Word;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
If ObjRec.Fail.Length<>0
Then Begin
Seek(TxtFile,ObjRec.Fail.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.Fail.Length),RR);
End
Else Move(Msg[1],TxtRec[0],Length(Msg));
End;
(*---------------------------------------------------------------------------*
Write the SUCCESS tekst of the current record
*---------------------------------------------------------------------------*)
Procedure Database.Success(Msg : String);
Var RR : Word;
Cnt: Word;
Len: Word;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
If ObjRec.Success.Length<>0
Then Begin
Seek(TxtFile,ObjRec.Success.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.Success.Length),RR);
End
Else Move(Msg[1],TxtRec[0],Length(Msg));
End;
(*---------------------------------------------------------------------------*
Read the OFAIL tekst of the current record
*---------------------------------------------------------------------------*)
Procedure Database.OFail(Msg : String);
Var RR : Word;
Cnt: Word;
Len: Word;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
If ObjRec.OFail.Length<>0
Then Begin
Seek(TxtFile,ObjRec.OFail.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.OFail.Length),RR);
End
Else Move(Msg[1],TxtRec[0],Length(Msg));
End;
(*---------------------------------------------------------------------------*
Read the OSUCCESS tekst of the current record
*---------------------------------------------------------------------------*)
Procedure Database.OSuccess(Msg : String);
Var RR : Word;
Cnt: Word;
Len: Word;
Begin
FillChar(TxtRec,SizeOf(TxtRec),#00);
If ObjRec.OSuccess.Length<>0
Then Begin
Seek(TxtFile,ObjRec.OSuccess.Start);
BlockRead(TxtFile,TxtRec,MaxLen(ObjRec.OSuccess.Length),RR);
End
Else Move(Msg[1],TxtRec[0],Length(Msg));
End;
(*---------------------------------------------------------------------------*
Return the name of the current object
*---------------------------------------------------------------------------*)
Function Database.Name:String;
Begin
If Pos(';',ObjRec.Name)>0
Then Name:=Copy(ObjRec.Name,1,Pos(';',ObjRec.Name)-1)
Else Name:=ObjRec.Name;
End;
(*---------------------------------------------------------------------------*
Functions to check the used flags.
*---------------------------------------------------------------------------*)
Function Database.IsRoom:Boolean;
Begin
IsRoom:=ObjRec.ObjType = Room_Type;
End;
Function Database.IsThing:Boolean;
Begin
IsThing:=ObjRec.ObjType = Thing_Type;
End;
Function Database.IsExit:Boolean;
Begin
IsExit:=ObjRec.ObjType = Exit_Type;
End;
Function Database.IsPlayer:Boolean;
Begin
IsPlayer:=ObjRec.ObjType = Player_Type;
End;
Function Database.IsDrone:Boolean;
Begin
IsDrone:=ObjRec.ObjType = DRONE_Type;
End;
Function Database.LevelOk(Level : Byte):Boolean;
Begin
LevelOk:=ObjRec.ObjLevel>=Level;
End;
Function DataBase.IsLinkOk:Boolean;
Begin
IsLinkOk:=(ObjRec.Attr_Flags And Link_Ok_Flag)=Link_Ok_Flag;
End;
Function Database.IsSticky:Boolean;
Begin
IsSticky:=(ObjRec.Attr_Flags And Sticky_Flag) = Sticky_Flag;
End;
Function Database.IsInvisible:Boolean;
Begin
IsInvisible:=(ObjRec.Attr_Flags And InVisible_Flag) = InVisible_Flag;
End;
Function DataBase.IsForSale:Boolean;
Begin
IsForSale:=(ObjRec.Attr_Flags And For_Sale_Flag)=For_Sale_Flag;
End;
Function DataBase.IsChownOK:Boolean;
Begin
IsChownOK:=(ObjRec.Attr_Flags And Chown_ok_Flag)=Chown_ok_Flag;
End;
Function Database.IsTemple:Boolean;
Begin
IsTemple:=(ObjRec.Room_Flags And Temple_Room)=Temple_Room;
End;
Function Database.IsHaven:Boolean;
Begin
IsHaven:=(ObjRec.Room_Flags And Haven_Room)=Haven_Room;
End;
Function Database.IsShop:Boolean;
Begin
IsShop:=(ObjRec.Room_Flags And Shop_Room)=Shop_Room;
End;
Function Database.IsLoud:Boolean;
Begin
IsLoud:=(ObjRec.Room_Flags And Loud_Room)=Loud_Room;
End;
Function Database.CanTeleport:Boolean;
Begin
CanTeleport:=(ObjRec.Attr_Flags And Teleport_Ok_Flag)=Teleport_Ok_Flag;
End;
Function Database.IsOwnedBy(Player : Integer):Boolean;
Begin
IsOwnedBy:=ObjRec.Owner=Player;
End;
Function DataBase.IsOwner(ObjNr : Integer):Boolean;
Begin
IsOwner:=ObjRec.Owner=ObjNr;
End;
Function Database.WhichGender:GenderType;
Begin
WhichGender:=GenderType(ObjRec.Sex);
End;
End.